home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / misc / utilitys / meteor.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  16.6 KB  |  452 lines
  1. 10  CLS: KEY OFF
  2. 20  PRINT:PRINT "           ***************** METEOR *******************": PRINT
  3. 30  PRINT "                 METEOR SCATTER PREDICTION PROGRAM
  4. 40  PRINT "                      MICHAEL R. OWEN, W9IP
  5. 50  PRINT "                          21 MAPLE ST.
  6. 60  PRINT "                       CANTON, NY  13617
  7. 70  PRINT
  8. 80   REM ***  THIS PROGRAM CALCULATES THE PEAK TIME FOR MAJOR METEOR
  9. 90   REM ***  SHOWERS.  IT ALSO PROVIDES INFORMATION CONCERNING THE
  10. 100  REM ***  OPTIMUM TIMES FOR PARTICULAR PATHS, IN GRAPHIC AND TABLE
  11. 110  REM ***  FORM.  THE PROGRAM IS WRITTEN FOR THE IBM-PC AND ALL
  12. 120  REM ***  COMPATIBLE COMPUTERS (MS-DOS OR PC-DOS, PLUS BASICA).
  13. 130  REM   ***********************************************************
  14. 140  REM   * PLEASE NOTE: YOU MUST ENTER YOUR OWN LATUTUDE AND       *
  15. 150  REM   * LONGITUDE ON LINES 190 AND 200 BELOW.  REMEMBER THAT    *
  16. 160  REM   * SOUTH LATITUDES AND WEST LONGITUDES ARE NEGATIVE.       *
  17. 170  REM   * YOU WILL ALSO WANT TO CHECK THE DEFAULT YEAR (LINE 3720)*
  18. 180  REM   ***********************************************************
  19. 190  MYLATD = 41.8: REM *** SOUTH LATITUDES ARE NEGATIVE!
  20. 200  MYLOND =-73.9: REM *** WEST LONGITUDES ARE NEGATIVE!
  21. 210  REM *** PC BASIC DOESN'T HAVE ARCCOS OR ARCSIN, SO DEFINE FUNCTIONS HERE
  22. 220  DEF FNACOS(X)=1.5708-ATN(X/SQR(1-X*X))
  23. 230  DEF FNARSIN(X)= ATN(X/SQR(1-X*X))
  24. 240  DIM LDATE(400),LTIME(400),LELEV(400),LAZIM(400)
  25. 250  REM *************************************
  26. 260  REM INITIALIZING PROGRAM: SETTING OPTIONS
  27. 270  REM *************************************
  28. 280  LENG=0: INCR=0: COUNTR=0: ENDER=1: BEST=0: HEADER=0: OPTDIR=0: BESEL=90
  29. 290  GOSUB 4400
  30. 300  IF COUNTR=1 THEN  CLS
  31. 310  PRINT: PRINT: PRINT
  32. 320  PRINT "                         OPTIONS:"
  33. 330  PRINT
  34. 340  PRINT "       1)  PEAK TIME PREDICTION"
  35. 350  PRINT "       2)  (1) PLUS GRAPH OF AZ/EL OF RADIANT FOR A PARTICULAR PATH"
  36. 360  PRINT "       3)  LISTING OF GOOD TIMES FOR ALL PATHS"
  37. 370  PRINT "       4)  BEST PATH FOR A PARTICULAR TIME"
  38. 380  PRINT
  39. 390  PRINT
  40. 400  INPUT "WHAT IS YOUR CHOICE (1-4)";WHICH
  41. 410  IF WHICH <1 OR WHICH>4 THEN 400
  42. 420  IF WHICH <>2 THEN 550
  43. 430  CLS: PRINT "WHICH GENERAL DIRECTION?"
  44. 440  PRINT: PRINT
  45. 450  PRINT "1) NORTH": PRINT "2) NORTHEAST": PRINT "3) EAST"
  46. 460  PRINT "4) SOUTHEAST": PRINT "5) SOUTH": PRINT "6) SOUTHWEST"
  47. 470  PRINT "7) WEST": PRINT "8) NORTHWEST"
  48. 480  PRINT: PRINT "9) SPECIFIC LAT,LON          (SOUTH LAT AND WEST LON ARE NEGATIVE)"
  49. 490  PRINT: PRINT "10) SPECIFIC BEARING FROM YOUR QTH (0-360)"
  50. 500  PRINT: PRINT: PRINT: INPUT "CHOOSE DIRECTION BY NUMBER (1-10)";DIRECTION
  51. 510  IF DIRECTION <1 OR DIRECTION >10 THEN 500
  52. 520  IF WHICH <>2 THEN 550
  53. 530  IF DIRECTION=9 THEN INPUT "OTHER STATION'S LAT,LONG ";HISLATD,HISLOND: GOSUB 3270
  54. 540  IF DIRECTION=10 THEN INPUT "BEARING (DEGREES)";LOOK
  55. 550  CLS: PRINT: PRINT: PRINT  "      METEOR SHOWER" TAB(27);"DATE"
  56. 560  PRINT
  57. 570  PRINT "    1)  QUADRANTIDS ";TAB(25);" 4 JANUARY"
  58. 580  PRINT "    2)  LYRIDS      ";TAB(25);"22 APRIL"
  59. 590  PRINT "    3)  ETA AQUARIDS";TAB(25);" 4 MAY"
  60. 600  PRINT "    4)  ARIETIDS    ";TAB(25);" 7 JUNE"
  61. 610  PRINT "    5)  PERSEIDS    ";TAB(25);"12 AUGUST"
  62. 620  PRINT "    6)  DRACONIDS   ";TAB(25);"10 OCTOBER"
  63. 630  PRINT "    7)  ORIONIDS    ";TAB(25);"20 OCTOBER"
  64. 640  PRINT "    8)  LEONIDS     ";TAB(25);"17 NOVEMBER"
  65. 650  PRINT "    9)  GEMINIDS    ";TAB(25);"13 DECEMBER"
  66. 660  PRINT: PRINT: PRINT
  67. 670  INPUT "FOR WHICH SHOWER DO YOU WANT INFORMATION (1-9)";SHOWER
  68. 680  IF SHOWER <1 OR SHOWER >9 THEN 670
  69. 690  GOSUB 3670: IF WHICH=1 THEN 2400
  70. 700  IF WHICH=4 THEN PRINT:PRINT: INPUT "WHAT TIME (OPT. 4)";STARTTIME: GOTO 780
  71. 710  PRINT: PRINT "FOR THIS RUN,                       DEFAULT VALUES IN [ ]"
  72. 720  PRINT: INPUT "HOW LONG? (HOURS)  [24]  "; LENG
  73. 730  IF LENG=0 THEN LENG=24: REM *** DEFAULT ON EMPTY RETURN
  74. 740  LENG=LENG*100
  75. 750  INPUT "WHAT INCREMENT (MINUTES)  [60]  "; INCR
  76. 760  IF INCR=0 THEN INCR=60: REM *** DEFAULT ON EMPTY RETURN
  77. 770  IF INCR>60 THEN INCR=CINT((INCR/60)*100)
  78. 780  PRINT "DO YOU WANT INFORMATION FOR THE PEAK DAY ("M"/"DAY")?   [Y]  ":INPUT CENT$
  79. 790  IF CENT$<>"N" THEN CENT$="Y": REM *** DEFAULT ON EMPTY RETURN
  80. 800  IF CENT$="Y" THEN 820
  81. 810  INPUT "WHAT DATE DO YOU WANT (MONTH, DAY)"; M,DAY
  82. 820  IF WHICH=4 THEN 870
  83. 830  INPUT "START TIME, UTC (EXAMPLE: 0000)   [0000]  "; STARTTIME
  84. 840  REM *** STARTTIME=0 IS AUTOMATIC
  85. 850  REM *** THIS LOOP "LOOKS" AROUND THE COMPASS AT 45 DEGREE INCREMENTS
  86. 860  IF WHICH=3 THEN FOR DIRECTION = 1 TO 8
  87. 870  ROUNDS=0
  88. 880  TIME=STARTTIME
  89. 890  TIMECOUNT=TIME
  90. 900  FINISH=TIMECOUNT+LENG+100
  91. 910  GOSUB 2490: T=S*15*R1
  92. 920  IF COUNTR>0 THEN 1070
  93. 930  REM *** INPUT RIGHT ASCENSION DATA: RAHOUR, RAMIN IN DATA STATEMENT.
  94. 940  REM *** A$ IS HOURS, A2 IS MIN, A3 IS SEC.
  95. 950  REM *** CHANGE THESE OR WRITE AN INPUT STATEMENT IF YOU WANT TO
  96. 960  REM *** EVALUATE OTHER METEOR SHOWERS (OR OTHER CELESTIAL OBJECTS)
  97. 970  A$= STR$(RAHOUR): A2=RAMIN: A3=0
  98. 980  GOSUB 2420: R=A*15*R1
  99. 990  REM *** INPUT DECLINATION, SAME COMMENTS AS ABOVE
  100. 1000  A$=STR$(DEC): A2=0: A3=0
  101. 1010  GOSUB 2420: DEG=A*R1
  102. 1020  IF WHICH<>4 THEN 1070
  103. 1030  PRINT: PRINT: PRINT "PLEASE WAIT"
  104. 1040  FOR BESTDIR=0 TO 355 STEP 5
  105. 1050  ANGLE=BESTDIR
  106. 1060  GOTO 1210
  107. 1070  IF WHICH=2 AND COUNTR=1 THEN 1240
  108. 1080  REM *** THIS SECTION CHOOSES PATHS IN 45 DEGREE STEPS
  109. 1090  IF DIRECTION = 9 THEN GOSUB 3270: GOSUB 2810: GOTO 1270
  110. 1100  IF DIRECTION = 1 THEN ANGLE=0:WAY$="N"
  111. 1110  IF DIRECTION = 2 THEN ANGLE=45: WAY$="NE"
  112. 1120  IF DIRECTION = 3 THEN ANGLE=90: WAY$="E"
  113. 1130  IF DIRECTION = 4 THEN ANGLE=135: WAY$="SE"
  114. 1140  IF DIRECTION = 5 THEN ANGLE=180: WAY$="S"
  115. 1150  IF DIRECTION = 6 THEN ANGLE=225: WAY$="SW"
  116. 1160  IF DIRECTION = 7 THEN ANGLE=270: WAY$="W"
  117. 1170  IF DIRECTION = 8 THEN ANGLE=315: WAY$="NW"
  118. 1180  IF DIRECTION = 10 THEN ANGLE=LOOK
  119. 1190  REM *** "RIGHT" AND "RIGHT2" ARE THE AZIMUTH OF POINTS AT
  120. 1200  REM ***  90 DEGREE ANGLES TO THE PATH OF INTEREST.
  121. 1210  RIGHT=(ANGLE+90) MOD 360: RIGHT2=(ANGLE+270) MOD 360
  122. 1220  IF WHICH=3 OR COUNTR=0 THEN IF ROUNDS=0 THEN GOSUB 4270
  123. 1230  IF ROUNDS=0 THEN MIDLATD=CIRLATD: MIDLOND=CIRLOND
  124. 1240  IF WHICH=2 AND COUNTR=0 THEN GOSUB 2810: REM SET UP GRAPH
  125. 1250  REM *** MIDLATD AND MIDLOND ARE THE SPOTS HALFWAY ALONG THE
  126. 1260  REM *** PATH OF INTEREST (THIS IS WHERE THE METEORS NEED TO BE).
  127. 1270  B=MIDLATD: L=MIDLOND
  128. 1280  B=B*R1: L=L*R1
  129. 1290  REM *** THIS SECTION DETERMINES THE AZ AND EL OF THE RADIANT BASED
  130. 1300  REM *** ON ITS R.A. AND DEC. AT PATH MIDPOINT.
  131. 1310  T5=T-R+L: REM LHA
  132. 1320  COSDEG=COS(DEG): SINDEG=SIN(DEG)
  133. 1330  SINB=SIN(B)
  134. 1340  S1=SINB*SINDEG
  135. 1350  COSINB=COS(B)
  136. 1360  S1=S1+COSINB*COSDEG*COS(T5)
  137. 1370  C1=1-S1*S1
  138. 1380  IF C1>0 THEN C1=SQR(C1)
  139. 1390  IF C1<=0 THEN 1410
  140. 1400  H=ATN(S1/C1): GOTO 1420
  141. 1410  H=SGN(S1)*P/2
  142. 1420  C2=(COSINB*SINDEG)-SINB*COSDEG*COS(T5)
  143. 1430  S2=-COSDEG*SIN(T5)
  144. 1440  IF C2=0 THEN A=SGN(S2)*P/2:GOTO 1470
  145. 1450  A=ATN(S2/C2)
  146. 1460  IF C2<0 THEN A=A+P
  147. 1470  IF A <0 THEN A=A+2*P
  148. 1480  ELEV=H/R1: AZIM=A/R1
  149. 1490  REM *** LOAD ARRAY WITH AZ, EL DATA
  150. 1500  IF WHICH<>2 THEN 1550
  151. 1510  LAZIM(ENDER)=AZIM
  152. 1520  LELEV(ENDER)=ELEV
  153. 1530  LDATE(ENDER)=DAY
  154. 1540  LTIME(ENDER)=TIME
  155. 1550  IF ELEV<0 THEN 1840
  156. 1560  QUAL=0: BEST=0
  157. 1570  REM *** ROUTINE TO INDICATE THE TIMES WHEN THE RADIANT IS
  158. 1580  REM *** WITHIN +/- 15 DEG OF PERPENDICULAR TO THE DESIRED
  159. 1590  REM *** PATH (GOOD) AND WHEN IT IS ALSO WITHIN +/- 15 DEG OF
  160. 1600  REM *** 45 DEG ELEVATION AT PATH MIDPOINT (BEST).
  161. 1605  IF ELEV<20 AND WHICH=4 THEN 1660
  162. 1610  IF ELEV<20 THEN 1740
  163. 1620  IF (AZIM>(RIGHT-15) AND AZIM<(RIGHT+15)) OR (AZIM>(RIGHT2-15) AND AZIM<(RIGHT2+15)) THEN QUAL=1
  164. 1630  IF QUAL=1 AND ELEV>30 AND ELEV<60 THEN BEST=1
  165. 1640  IF WHICH<>4 THEN 1740
  166. 1650  IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESTEL) THEN OPTDIR=ANGLE: BESTEL=ELEV
  167. 1660  NEXT BESTDIR
  168. 1670  BEEP: COLOR 15
  169. 1680  IF OPTDIR>1 THEN 1720
  170. 1690  PRINT: PRINT "NO GOOD DIRECTIONS AT";TIME;"UTC."
  171. 1700  PRINT: PRINT "RUN OPTION 2 TO CHECK IF RADIANT IS ABOVE HORIZON"
  172. 1710  PRINT: PRINT: COLOR 7: GOTO 2200
  173. 1720  PRINT:PRINT "BEST DIRECTION AT";TIME; "UTC ="OPTDIR;"DEGREES"
  174. 1730  COLOR 7: GOTO 2200
  175. 1740  IF WHICH=3 THEN 1790
  176. 1750  IF QUAL=1 AND BEST=0 THEN LOCATE 23,10:PRINT "GOOD TIME:" TIME
  177. 1760  COLOR 15
  178. 1770  IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESEL) THEN BESEL=ELEV:BESTIME=TIME
  179. 1780  COLOR 7
  180. 1790  IF WHICH=3 AND HEADER=0 THEN GOSUB 2990
  181. 1800  IF QUAL=1 AND BEST=0 AND WHICH=3 THEN PRINT TIME,WAY$
  182. 1810  COLOR 15
  183. 1820  IF BEST=1 AND WHICH=3 THEN  PRINT TAB(30) TIME,WAY$
  184. 1830  COLOR 7
  185. 1840  IF WHICH <>2 THEN 2020
  186. 1850  IF COUNTR<>0 THEN 1920
  187. 1860  LOCATE 21,5
  188. 1870  PRINT"NORTH                        SOUTH                        NORTH"
  189. 1880  REM *** PLOT THE APPROXIMATE AZ, EL DATA FOR
  190. 1890  REM *** THE RADIANT AS A FUNCTION OF TIME.
  191. 1900  REM *** THE 'LOCATE' ARGUMENT IS DERIVED FROM
  192. 1910  REM *** INTEGER VALUES OF AZ AND EL.
  193. 1920  J=CINT(AZIM/6)+5
  194. 1930  I=CINT(20-(ELEV/5))
  195. 1940  IF I<=0 THEN I=1
  196. 1950  IF I>20 THEN I=20
  197. 1960  PNT$=STR$(INT(TIME/100))
  198. 1970  IF I=20 THEN 2020
  199. 1980  REM *** HIGHLIGHT BEST TIMES ON THE GRAPH
  200. 1990  IF BEST=1 THEN COLOR 15
  201. 2000  LOCATE I,J: PRINT "*";PNT$
  202. 2010  COLOR 7
  203. 2020  TIMECOUNT=TIMECOUNT+INCR
  204. 2030  IF TIMECOUNT-(INT(TIMECOUNT/100)*100)=>60 THEN TIMECOUNT=TIMECOUNT+40
  205. 2040  TIME=TIME+INCR
  206. 2050  COUNTR=1: ENDER=ENDER+1
  207. 2060  ROUNDS=1
  208. 2070  IF TIMECOUNT<FINISH THEN 910
  209. 2080  IF WHICH=2 AND DIRECTION < 9 THEN LOCATE 23,55: PRINT WAY$;" PATH"
  210. 2090  IF WHICH=2 AND DIRECTION>8 THEN LOCATE 23,55:PRINT "BEARING:";CINT(ANGLE);"DEG."
  211. 2100  IF WHICH=3 THEN NEXT DIRECTION: BEEP: GOTO 2200
  212. 2110  IF BESTIME=0 THEN 2130
  213. 2120  LOCATE 23,30: PRINT "BEST TIME:"BESTIME
  214. 2130  LOCATE 24,10
  215. 2140  IF WHICH=2 THEN INPUT "DO YOU WANT LISTED OUTPUT"; LISTED$
  216. 2150  IF LISTED$="Y" THEN PRINT: PRINT "                SHOWER: ";SHOWER$: PRINT
  217. 2160  IF LISTED$="Y" THEN PRINT"DAY","TIME, UTC","AZIMUTH","ELEVATION" ELSE 2200
  218. 2170  FOR K=1 TO ENDER-1
  219. 2180  PRINT LDATE(K),LTIME(K),LAZIM(K),LELEV(K)
  220. 2190  NEXT K
  221. 2200  INPUT "DO YOU WANT ANOTHER RUN (Y/N)"; AGAIN$
  222. 2210  IF AGAIN$="Y" THEN COUNTR=0: ENDER=0: PRINTED=0: BESTEL=999
  223. 2220  IF AGAIN$="Y" THEN 280 ELSE 2400
  224. 2230  REM **************************************************
  225. 2240  REM   DATA FOR MAJOR (AND SOME MINOR) METEOR SHOWERS
  226. 2250  REM   FROM "ASTRONOMICAL CALENDAR 1985" BY GUY OTTWELL,
  227. 2260  REM   PHYSICS DEPT, FURMAN UNIV.,GREENVILLE, SC.
  228. 2270  REM **************************************************
  229. 2280  REM *** DATA FORMAT: NAME, E.L., MONTH, DAY, TIME ABOVE QUARTER MAX,
  230. 2290  REM *** VELOCITY (KM/SEC), APPROX. RATE, RADIANT R.A. HOURS, R.A. MINUTES,
  231. 2300  REM *** DECLINATION, CEPLECHA'S CLASS, HEIGHT OF IONIZATION (KM)
  232. 2310  DATA QUADRANTIDS,282.80,1,4,14 HOURS,41.5,110,15,28,50,B,100
  233. 2320  DATA LYRIDS,31.4,4,21,2.3 DAYS,47,VARIABLE,18,8,32,BC,105
  234. 2330  DATA ETA AQUARIDS,44,5,4,3 DAYS,67,21,22,20,-1,C2,115
  235. 2340  DATA ARIETIDS,75.0,6,5,RICH BUT SMALL,37,60,2,56,23,UNKNOWN,100
  236. 2350  DATA PERSEIDS,139.3,8,11,4.6 DAYS,60,68,3,4,58,C2,110
  237. 2360  DATA DRACONIDS, 196.3,10,10,1.2 HOURS,21,42,17,28,54,C1,97
  238. 2370  DATA ORIONIDS, 207,10,20,2 DAYS,67,35,6,20,15,C2,115
  239. 2380  DATA LEONIDS, 234.7,11,16,4 DAYS,71,40,10,8,22,C2,150
  240. 2390  DATA GEMINIDS, 261.9,12,13,2.6 DAYS,35,58,7,28,32,B,95
  241. 2400  KEY ON: END
  242. 2410  REM *********************************
  243. 2420  REM SEXAGESIMAL TO DECIMAL CONVERSION
  244. 2430  REM *********************************
  245. 2440  S=1: A1=ABS(VAL(A$))
  246. 2450  IF LEFT$(A$,1)="-" THEN S=-1
  247. 2460  A=S*(A1+A2/60+A3/3600)
  248. 2470  RETURN
  249. 2480  REM ***************************************
  250. 2490  REM GREENWICH MEAN SIDERIAL TIME CONVERSION
  251. 2500  REM ***************************************
  252. 2510  HOUR=INT(TIME/100)
  253. 2520  MIN=TIME-(HOUR*100)
  254. 2530  IF MIN=>60 THEN TIME=TIME+40: GOTO 2510
  255. 2540  IF TIME>2400 THEN TIME=TIME-2400: DAY=DAY+1
  256. 2550  HOUR=HOUR/24: MIN=MIN/1440
  257. 2560  D=DAY+HOUR+MIN
  258. 2570  D1=INT(D): F=D-D1-0.5
  259. 2580  J=-INT(7*(INT((M+9)/12)+Y)/4)
  260. 2590  S=SGN(M-9): A=ABS(M-9)
  261. 2600  J1=INT(Y+S*INT(A/7))
  262. 2610  J1=-INT((INT(J1/100)+1)*3/4)
  263. 2620  J=J+INT(275*M/9)+D1+J1
  264. 2630  J=J+1.72103E+06+2+367*Y
  265. 2640  IF F>=0 THEN 2670
  266. 2650  F=F+1: J=J-1
  267. 2660  D=J-2.45154E+06
  268. 2670  T=D/36525: T1=INT(T)
  269. 2680  J0=T1*36525+2.45154E+06
  270. 2690  T2=(J-J0+0.5)/36525
  271. 2700  S=24110.5+184.813*T1
  272. 2710  S=S+8.64018E+06*T2
  273. 2720  S=S+0.093104*T*T
  274. 2730  S=S-6.198E-06*T*T*T
  275. 2740  S=S/86400: S=S-INT(S)
  276. 2750  S=24*(S+(F-0.5)*1.00274)
  277. 2760  IF S<0 THEN S=S+24
  278. 2770  IF S>24 THEN S=S-24
  279. 2780  RETURN
  280. 2790  REM *******************************
  281. 2800  REM ROUTINE TO INITIALIZE THE GRAPH
  282. 2810  REM *******************************
  283. 2820  CLS
  284. 2830  LOCATE 1,22: PRINT "SHOWER: ";SHOWER$; "(";M;"/"DAY;"/"Y;")"
  285. 2840  LOCATE 2,13
  286. 2850  PRINT "AZ, EL OF RADIANT AT PATH MIDPOINT: LAT";CINT(MIDLATD);"LON ";CINT(MIDLOND)
  287. 2860  FOR I=2 TO 20
  288. 2870  LOCATE I,3:PRINT (90-(I*5))+10
  289. 2880  NEXT I
  290. 2890  LOCATE 5,1: PRINT "E": LOCATE 6,1: PRINT "L": LOCATE 7,1: PRINT "E"
  291. 2900  LOCATE 8,1: PRINT "V": LOCATE 9,1: PRINT "A": LOCATE 10,1: PRINT "T"
  292. 2910  LOCATE 11,1: PRINT "I": LOCATE 12,1: PRINT "O": LOCATE 13,1: PRINT "N"
  293. 2920  REM SET BOTTOM AXIS
  294. 2930  FOR J=5 TO 65 STEP 5
  295. 2940  LOCATE 20,J-1:PRINT (J-5)*6
  296. 2950  NEXT J
  297. 2960  LOCATE 11,7: PRINT "-------------------------------------------------------------"
  298. 2970  RETURN
  299. 2980  REM *************************
  300. 2990  REM ROUTINE TO TITLE OPTION 3
  301. 3000  REM A************************
  302. 3010  CLS: PRINT "SHOWER: ";SHOWER$ "   DATE: "M;"/"DAY;"/"Y; "  PEAK AT ";GMT;" UTC": PRINT:
  303. 3020  PRINT "    GOOD TIMES"
  304. 3030  COLOR 15
  305. 3040  LOCATE 3,33: PRINT "BEST TIMES"
  306. 3050  COLOR 7
  307. 3060  HEADER=1
  308. 3070  RETURN
  309. 3080  REM *********************************************
  310. 3090  REM ROUTINE TO CALCULATE ECLIPTIC LONGITUDE FROM
  311. 3100  REM 'THE ASTRONOMICAL ALMANAC FOR 1985' PAGE C24.
  312. 3110  REM *********************************************
  313. 3120  JC#=CDBL(J)
  314. 3130  FC#=CDBL(F)
  315. 3140  JD#=JC#+FC#
  316. 3150  REM *** JD# IS DOUBLE-PRECISION JULIAN DAY
  317. 3160  N#=JD#-2.45154E+06
  318. 3170  LONSUN#=280.46+(0.985647*N#)
  319. 3180  G#=357.528+(0.9856*N#)
  320. 3190  IF LONSUN#<0 THEN LONSUN#=LONSUN#+360
  321. 3200  IF G#<0 THEN G#=G#+360
  322. 3210  IF LONSUN#<0 THEN 3190
  323. 3220  IF G#<0 THEN 3200
  324. 3230  RCON#=180/3.14159
  325. 3240  LONSUNT#=LONSUN#+(1.915*SIN(G#/RCON#))+(0.02*SIN(2*(G#/RCON#)))
  326. 3250  RETURN
  327. 3260  REM *********************************************
  328. 3270  REM ROUTINE TO DETERMINE THE BEARING AND DISTANCE
  329. 3280  REM BETWEEN ANY TWO POINTS ON THE EARTH.
  330. 3290  REM *********************************************
  331. 3300  IF DIRECTION<>9 THEN HISLATD=CIRLATD: HISLOND=CIRLOND
  332. 3310  DIFLOND=MYLOND-HISLOND
  333. 3320  MIDLATD=MYLATD-((MYLATD-HISLATD)/2)
  334. 3330  REM *** DIFFERENCE IN LONGITUDES MUST FALL BETWEEN -180 AND +180
  335. 3340  IF DIFLOND<-180 THEN DIFLOND=DIFLOND+360
  336. 3350  IF DIFLOND>180 THEN DIFLOND=DIFLOND-360
  337. 3360  REM *** DEGREES TO RADIANS CONVERSION
  338. 3370  HISLAT=HISLATD*R1: HISLON=HISLOND*R1
  339. 3380  DIFLON=DIFLOND*R1
  340. 3390  REM *** DISTANCE CALCULATION
  341. 3400  COSB=(SMYLAT*SIN(HISLAT))+(CMYLAT*COS(HISLAT)*COS(DIFLON))
  342. 3410  BETA=FNACOS(COSB)
  343. 3420  BETA2=BETA/R1
  344. 3430  REM *** '69.05' IS THE CONVERSION FACTOR FOR STATUTE MILES.
  345. 3440  REM *** FOR KILOMETERS, USE 111.2, AND FOR NAUTICAL MILES 60.0.
  346. 3450  DIST=BETA2*69.05
  347. 3460  REM *** BEARING CALCULATION
  348. 3470  COSA=(SIN(HISLAT)-(SMYLAT*COSB))/(CMYLAT*SIN(BETA))
  349. 3480  REM *** ROUNDING ERRORS SOMETIMES LET COSA>1 OR <-1 (ERROR)
  350. 3490  IF COSA>1 THEN COSA=1
  351. 3500  IF COSA<-1 THEN COSA=-1
  352. 3510  AZ=FNACOS(COSA)
  353. 3520  ANGLE=AZ/R1
  354. 3530  REM *** HAFLON IS THE LON OF A POINT BETWEEN HERE AND THERE
  355. 3540  HAFLON=FNACOS((COS(BETA/2)-(SMYLAT*SIN(MIDLATD*R1)))/(CMYLAT*COS(MIDLATD*R1)))
  356. 3550  IF DIFLOND>0 THEN ANGLE=360-ANGLE
  357. 3560  IF DIRECTION<>9 OR PRINTED=1 OR WHICH<>2 THEN 3600
  358. 3570  PRINT: PRINT "DISTANCE: ";DIST;" MILES," BETA2*111.2;" KM";"   BEARING:";ANGLE;" DEGREES"
  359. 3580  INPUT "PRESS 'ENTER' TO CONTINUE" ;PAUSE$
  360. 3590  PRINTED=1
  361. 3600  IF ANGLE>180 THEN HAFLON=MYLON-HAFLON ELSE HAFLON=MYLON+HAFLON
  362. 3610  MIDLOND=HAFLON/R1
  363. 3620  RETURN
  364. 3630  REM ************************************************************
  365. 3640  REM ROUTINE TO READ DATA AND CALCULATE PEAK DATE/TIME MODIFIED
  366. 3650  REM AFTER PROGRAMS BY RUSS WICKER (W4WD) AND JOE REISERT (W1JR).
  367. 3660  REM ************************************************************
  368. 3670  FOR I=1 TO SHOWER
  369. 3680  READ SHOWER$,ELON,M,DAY,DURATION$,VELOCITY$,RATE$,RAHOUR,RAMIN,DEC,CLASS$,HEIGHT
  370. 3690  NEXT I
  371. 3700  RESTORE
  372. 3710  PRINT: PRINT: INPUT "        WHAT YEAR     [1985]  "; Y
  373. 3720  IF Y=0 THEN Y=1985
  374. 3730  TIME=0
  375. 3740  GOSUB 2490
  376. 3750  GOSUB 3090
  377. 3760  IF LONSUNT#>ELON THEN 3810
  378. 3770  DAY=DAY+1
  379. 3780  GOSUB 2490
  380. 3790  GOSUB 3090
  381. 3800  GOTO 3760
  382. 3810  IF LONSUNT#<=ELON THEN 3860
  383. 3820  E2=LONSUNT#
  384. 3830  DAY=DAY-1
  385. 3840  GOSUB 2490
  386. 3850  GOSUB 3090
  387. 3860  T=24*((ELON-LONSUNT#)/(E2-LONSUNT#))
  388. 3870  H0=INT(T)
  389. 3880  M1=INT(60*(T-H0)+0.5)
  390. 3890  GMT=100*H0+M1
  391. 3900  IF GMT<0 THEN DAY=DAY-1: GOTO 3740
  392. 3910  IF DAY<=31 THEN 3940
  393. 3920  DAY=DAY-31
  394. 3930  M=M+1
  395. 3940  CLS: PRINT: PRINT
  396. 3950  PRINT "THE ";SHOWER$;" METEOR SHOWER WILL PEAK ON";M;"/";DAY;"/";Y
  397. 3960  PRINT "AT";GMT;"UTC."
  398. 3970  IF WHICH>1 THEN 700
  399. 3980  PRINT: PRINT: INPUT "MORE INFO ON THIS SHOWER    [Y]  ";MOREINFO$
  400. 3990  IF MOREINFO$<>"N" THEN MOREINFO$="Y"
  401. 4000  IF MOREINFO$<>"Y" THEN 4190
  402. 4010  PRINT
  403. 4020  PRINT "     SHOWER: ";SHOWER$
  404. 4030  PRINT: PRINT "DURATION ABOVE QUARTER MAX.: ";DURATION$
  405. 4040  PRINT "VELOCITY: ";VELOCITY$;" KM/SEC"
  406. 4050  PRINT "AVERAGE HEIGHT OF IONIZATION: "; HEIGHT;" KM"
  407. 4060  PRINT "METEORS PER HOUR (APPROX): " RATE$
  408. 4070  PRINT "E.L. USED FOR CALCULATION: ";ELON;" DEGREES  (EPOCH 2000.0)"
  409. 4080  PRINT "R.A. OF RADIANT: ";RAHOUR;" HR ";RAMIN;" MIN"
  410. 4090  PRINT "DECLINATION:"; DEC "DEGREES"
  411. 4100  PRINT "CEPLECHA'S CLASS: ";CLASS$
  412. 4110  TIME=GMT: GOSUB 2490: GOSUB 3090: ROUNDLON=INT(LONSUNT#*1000)/1000
  413. 4120  PRINT: PRINT "E.L. AT"GMT"=";ROUNDLON
  414. 4130  TIME=0: GOSUB 2490: GOSUB 3090: ROUNDLON=INT(LONSUNT#*1000)/1000
  415. 4140  DEGLON=INT(LONSUNT#): MINLON=INT((LONSUNT#-DEGLON)*60)
  416. 4150  SECLON=(INT((((LONSUNT#-DEGLON)*60)-MINLON)*60)*100)/100
  417. 4160  REM *** NEXT LINE IS DISPLAYED SO YOU CAN CHECK THE CALCULATED
  418. 4170  REM *** E.L. AGAINST THE NAUTICAL ALMANAC.
  419. 4180  PRINT "E.L. AT 0000 =";ROUNDLON,"(=";DEGLON;"DEGREES";MINLON;"MINUTES";SECLON "SECONDS)"
  420. 4190  PRINT: INPUT "DO YOU WANT ANOTHER RUN (Y/N)     [Y]   ";ANOTHER$
  421. 4200  IF ANOTHER$<>"N" THEN ANOTHER$="Y"
  422. 4210  IF ANOTHER$="Y" THEN 300 ELSE 2400
  423. 4220  RETURN
  424. 4230  REM ****************************************************
  425. 4240  REM *** ROUTINE TO CALCULATE LAT, LON OF A 500-MI CIRCLE
  426. 4250  REM *** WHICH REPRESENTS THE 1000-MILE PATH MIDPOINT
  427. 4260  REM ****************************************************
  428. 4270  COSA2=COS(ANGLE*R1): REM *** ANGLE IS THE BEARING FROM YOUR QTH
  429. 4280  REM *** CIRLATD IS THE LATITUDE OF THE POINT
  430. 4290  CIRLAT=FNARSIN ((COSA2*CMYLAT*SINBETA2)+(SMYLAT*COSBETA2))
  431. 4300  CIRLATD=CIRLAT/R1
  432. 4310  REM *** CIRLOND IS THE LONGITUDE OF THE POINT
  433. 4320  CIRLON= (COSBETA2-(SMYLAT*SIN(CIRLAT)))/(CMYLAT*COS(CIRLAT))
  434. 4330  IF CIRLON>1 THEN CIRLON=1
  435. 4340  IF CIRLON<-1 THEN CIRLON=-1
  436. 4350  CIRLON=FNACOS(CIRLON)
  437. 4360  IF ANGLE>180 THEN CIRLON=MYLON-CIRLON ELSE CIRLON=MYLON+CIRLON
  438. 4370  CIRLOND=CIRLON/R1
  439. 4380  RETURN
  440. 4390  REM *********************************************
  441. 4400  REM *** ROUTINE TO INITIALIZE VARIABLES WHICH ARE
  442. 4410  REM *** USED OFTEN.  THIS SPEEDS THINGS UP.
  443. 4420  REM *********************************************
  444. 4430  P=3.14159: R1=P/180
  445. 4440  MYLON=MYLOND*R1: MYLAT=MYLATD*R1
  446. 4450  CMYLAT=COS(MYLAT): SMYLAT=SIN(MYLAT)
  447. 4460  REM *** CIRRANGE=500 IS THE DISTANCE TO PATH MIDPOINT; THIS
  448. 4470  REM *** REPRESENTS A 1000-MILE RANGE; CHANGE FOR ANOTHER DISTANCE.
  449. 4480  CIRRANGE=500:CIRBETA2=(CIRRANGE/69.05)*R1:REM FOR KM CHANGE 69.05 TO 111.2
  450. 4490  COSBETA2=COS(CIRBETA2): SINBETA2=SIN(CIRBETA2)
  451. 4500  RETURN
  452.